#!/usr/bin/perl -wc

package RFCMail::PackIt::Access;

use strict;
use warnings;
use bytes;

our %Read_Methods;
our %Write_Methods;

# Object structure is ARRAY
#  0: data (scalar); the data content of the object
#  1: cursor (scalar); point where read/write operations take effect

sub register_type {
    my ($class, $type, $read, $write) = @_;
    $Read_Methods{$type} = $read;
    $Write_Methods{$type} = $write;
}


sub unregister_type {
    my ($class, $type) = @_;
    delete $Read_Methods{$type};
    delete $Write_Methods{$type};
}


sub new {
    my ($class, $data) = @_;
    $data ||= "";
    return (bless [$data, 0], $class);
}


sub data { $_[0]->[0] }


sub dataref { \$_[0]->[0] }


sub read {
    my ($self, $need) = @_;
    my $take = substr($self->[0], $self->[1], $need);
    my $got = length($take);
    die "read past end of data"
	if $got < $need;
    $self->[1] += $got;
    return ($take);
}


sub read_type {
    my ($self, $type) = @_;
    die "attempt to read unregistered type '$type'"
	if not exists($Read_Methods{$type});
    return ($Read_Methods{$type}($self));
}


sub remainder {
    my ($self) = @_;
    my $rest = substr($self->[0], $self->[1]);
    $self->[1] = length($self->[0]);
    return ($rest);
}


sub at_end {
    my ($self) = @_;
    return ($self->[1] >= length($self->[0]));
}


sub write {
    my $self = shift;
    my $data = join("", @_);
    my $len = length($data);
    substr($self->[0], $self->[1], $len, $data);
    $self->[1] += $len;
}


sub write_type {
    my $self = shift;
    my $type = shift;
    die "attempt to write unregistered type '$type'"
	if not exists($Write_Methods{$type});
    $Write_Methods{$type}($self, @_);
}

1;
